perm filename SHFT.F4[MSS,LCS]1 blob
sn#258332 filedate 1977-01-12 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 INTEGER PACK
C00003 ENDMK
Cā;
INTEGER PACK
DIMENSION J(5)
4 TYPE 1
1 FORMAT(' TYPE '$)
ACCEPT 2,J
2 FORMAT(5A1)
K=PACK(J)
TYPE 3,K
3 FORMAT(1XA5)
GO TO 4
END
INTEGER FUNCTION PACK(JA)
DIMENSION JA(5)
DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
DATA MM/"774000000000/
JX=6
DO 10 K=5,1,-1
10 IF(JA(K).EQ.' ')JX=K
IA=JA(1)
IF(IA)IA=MM.AND.JA(1)
J2=2
7 IB=JA(J2)
IBX=IB
IF(IBX)IB=MM.AND.JA(J2)
11 K=IB.AND.LL
4 K=K/KK
5 IF(IBX)K=K.OR.JJ
C RESTORES LEFT HAND BIT (101 ETC.)
IF(J2.EQ.2)GO TO 3
DO 8 JL=1,J2-2
8 K=K/KK
3 N=IA.OR.K
IA=N
J2=J2+1
IF(J2.NE.JX)GO TO 7
PACK=N
END